home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / pas_all.zip / TI990.ASC < prev    next >
Text File  |  1992-05-19  |  3KB  |  199 lines
  1.  
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.   PRODUCT  :  Turbo Pascal                           NUMBER  :  990
  9.   VERSION  :  1.0
  10.        OS  :  Windows
  11.      DATE  :  May 19, 1992                             PAGE  :  1/3
  12.  
  13.     TITLE  :  Changing Fonts in Edits Controls
  14.  
  15.  
  16.  
  17.  
  18.   {$X+}
  19.   program EditFonts;
  20.   {
  21.     Changing an edit controls font settings.
  22.   }
  23.  
  24.   uses WObjects, WinProcs, WinTypes, Strings;
  25.  
  26.   const
  27.     id_Font = 201;
  28.  
  29.   Type
  30.     TMyApplication = object(TApplication)
  31.       procedure InitMainWindow; virtual;
  32.     end;
  33.  
  34.     PMyWIndow = ^TMyWindow;
  35.     TMyWindow = object(TWindow)
  36.       constructor Init(AParent: PWindowsObject; ATitle: PChar);
  37.       procedure Font(var Msg: TMessage);
  38.                      virtual id_First + id_Font;
  39.       procedure SetupWindow; virtual;
  40.     end;
  41.  
  42.   var
  43.     MyEdit: PEdit;
  44.     Button: PButton;
  45.  
  46.   { TMyApplication }
  47.   procedure TMyApplication.InitMainWindow;
  48.   begin
  49.      MainWindow:= new(PMyWindow,init(nil,
  50.                       'Changing TEdit Control''s Font'));
  51.   end;
  52.  
  53.   Constructor TMyWindow.Init(AParent: PWindowsObject; ATitle:
  54.   PChar);
  55.   begin
  56.     TWindow.Init(AParent, ATitle);
  57.     MyEdit := new(PEdit, Init(@ Self, 200, 'Information',
  58.                   1,1,100,50,0, False));
  59.     Button := new(PButton, init(@ Self, 201, '&Font',
  60.                   100,100,100,50,True));
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.   PRODUCT  :  Turbo Pascal                           NUMBER  :  990
  75.   VERSION  :  1.0
  76.        OS  :  Windows
  77.      DATE  :  May 19, 1992                             PAGE  :  2/3
  78.  
  79.     TITLE  :  Changing Fonts in Edits Controls
  80.  
  81.  
  82.  
  83.  
  84.   end;
  85.  
  86.   procedure TMyWindow.SetupWindow;
  87.   begin
  88.    TWindow.SetupWindow;
  89.    SetFocus(Button^.hWindow);
  90.   end;
  91.  
  92.   procedure TMyWindow.Font(var Msg: TMessage);
  93.   var
  94.     LogFont: TLogFont;
  95.     DC: hDC;
  96.   begin
  97.     { set up the LogFont structure }
  98.     With LogFont do
  99.       begin
  100.         lfHeight := 15;
  101.         lfWidth:=0;
  102.         lfEscapement:=0;
  103.         lfOrientation:=0;
  104.         lfWeight:= FW_Normal or FW_Regular;
  105.         lfItalic:= 0;
  106.         lfUnderLine:= 0;
  107.         lfStrikeOut:= 0;
  108.         lfCharSet:= ANSI_CharSet;
  109.         lfOutPrecision:= Out_Default_Precis;
  110.         lfClipPrecision:= Clip_Default_Precis;
  111.         lfQuality:=Default_Quality;
  112.         lfPitchandFamily:= Default_Pitch and ff_DontCare;
  113.         StrCopy(lfFaceName, 'Courier');
  114.       end;
  115.  
  116.     DC := GetDC(HWindow);
  117.  
  118.     { send message to change the font }
  119.     SendMessage(MyEdit^.hWindow, WM_SetFont,
  120.                 CreateFontIndirect(LogFont) , 1);
  121.     DeleteObject(CreateFontIndirect(LogFont));
  122.  
  123.     { change the button's text to 'Done' }
  124.     SetWindowText(Button^.hWindow, 'Done');
  125.     { must send message to button's paint }
  126.     { to update the button's text         }
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.   PRODUCT  :  Turbo Pascal                           NUMBER  :  990
  141.   VERSION  :  1.0
  142.        OS  :  Windows
  143.      DATE  :  May 19, 1992                             PAGE  :  3/3
  144.  
  145.     TITLE  :  Changing Fonts in Edits Controls
  146.  
  147.  
  148.  
  149.  
  150.     SendMessage(Button^.HWindow, wm_Paint, 0, 1);
  151.     ReleaseDC(HWindow, DC);
  152.   end;
  153.  
  154.   var
  155.     MyApp: TMyApplication;
  156.   begin
  157.     MyApp.Init('MyProgram');
  158.     MyApp.Run;
  159.     MyApp.Done;
  160.   end.
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.